home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / ole1v10a.lha / OLE_System / ole / DupObjects.ole < prev    next >
Encoding:
Text File  |  1995-02-10  |  5.3 KB  |  269 lines
  1. /*
  2.  * DupObjects.ole
  3.  *
  4.  * USAGE: DupObjects.ole
  5.  *
  6.  * DupObjects.ole is the GUI for all modules that multiply objects in the
  7.  * OLE System. Expecially dedicated to Antonello Troccola, one friend of
  8.  * mine.
  9.  *
  10.  * HISTORY:
  11.  * v1.01    eliminated the possibility to change the measure units
  12.  *            added the ability to remember the last values inserted
  13.  *
  14.  * v1.02    added ActivateGadget()
  15.  *
  16.  * v1.03    aligned with the new server design v1.10
  17.  *
  18.  * $(C): (1994, Rocco Coluccelli, Bologna)
  19.  * $VER: DupObjects.ole 1.03 (30.Nov.1994)
  20.  */
  21.  
  22. OPTIONS RESULTS
  23.  
  24. PARSE ARG oleclip
  25. PARSE VALUE GETCLIP(oleclip) WITH jobID modID box.left box.top char.w char.h olewin oleport olehost . . olepipe locale config .
  26.  
  27. IF ~SHOW('C',config) THEN
  28.     memory = 1
  29. ELSE
  30.     PARSE VALUE GETCLIP(config) WITH memory','
  31.  
  32.     inc. = 0; num. = 0
  33.  
  34.  
  35. ADDRESS VALUE oleport
  36.  
  37. /*
  38.  *    TODO: management for the ENV variables
  39.  */
  40. env = 'DupObjects.ole'
  41.  
  42. clip = GETENV(env)
  43. IF clip ~= '' THEN PARSE VAR clip num.rows inc.rows num.cols inc.cols .
  44.  
  45.  
  46. IF OPENPORT(olehost) == NULL() THEN DO
  47.     ERROR jobID modID 1 olehost
  48.     SETJOB jobID 'end'
  49.     EXIT 10
  50.     END
  51.  
  52. st = GUIGads()
  53. DO UNTIL st = 'end'
  54.  
  55.     CALL WAITPKT(olehost)
  56.     pkt = GETPKT(olehost)
  57.  
  58.     IF pkt == NULL() THEN ITERATE
  59.  
  60.     PARSE VALUE GETARG(pkt) WITH cmd argv .
  61.     PARSE VALUE GETARG(pkt,1) WITH n0 nn .
  62.  
  63.     SELECT
  64.  
  65.         WHEN cmd = 'INC' THEN DO
  66.             inc = GETARG(pkt,2)
  67.  
  68.             IF ~DATATYPE(inc,'N') THEN inc = 0
  69.  
  70.             inc.argv = inc; g_str.n0 = inc
  71.         END
  72.  
  73.         WHEN cmd = 'NUM' THEN DO
  74.             num = GETARG(pkt,2)
  75.             IF num < 0 THEN num = 0
  76.  
  77.             num.argv = num; g_str.n0 = num
  78.         END
  79.  
  80.         WHEN cmd = 'MEM' THEN DO
  81.             memory = ~memory
  82.             g_str.n0 = memory
  83.  
  84.             CALL SETCLIP(config,memory',')
  85.         END
  86.  
  87.         WHEN cmd = 'UNICONIFY' THEN
  88.             CALL Gadgets(8,1,g_gads)
  89.  
  90.         WHEN cmd = 'HELP' THEN
  91.             ABOUT jobID modID 'HELP' || st
  92.  
  93.         WHEN cmd = 'START' | cmd = 'QUIT' THEN
  94.             st = 'end'
  95.  
  96.         OTHERWISE NOP
  97.  
  98.     END
  99.  
  100.     IF n0 ~= '' THEN DO
  101.         CALL Gadgets(2,n0)
  102.         IF nn ~= '' THEN CALL ActivateGadget(olewin,GAD.nn)
  103.         END
  104.  
  105.     CALL REPLY(pkt,0)
  106. END
  107.  
  108.  
  109. CALL CLOSEPORT(olehost)
  110.  
  111. IF cmd = 'QUIT' THEN EXIT 0
  112.  
  113. IF num.rows + num.cols = 0 THEN DO
  114.     SETJOB jobID 'end'
  115.     EXIT 0
  116.     END
  117.  
  118. clip = num.rows inc.rows num.cols inc.cols
  119.  
  120. IF memory THEN
  121.     CALL SETENV(env,clip)
  122. ELSE
  123.     CALL SETENV(env,'')
  124.  
  125. CALL SETCLIP(olepipe,clip)
  126.  
  127. SETJOB jobID modID + 1
  128. CALL CloseWindow(olewin)
  129. EXIT 0
  130.  
  131.  
  132. GetLocale: PROCEDURE EXPOSE locale
  133. ARG strID
  134.  
  135.     strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale) WITH (strID)text'Þ'
  136.  
  137. RETURN text
  138.  
  139.  
  140. GUIGads:
  141.  
  142.     g_offx. = 2;    g_offx.1 = 0;            g_offx.3 = 2
  143.     g_offy. = 2;    g_offy.1 = char.h + 1;    g_offy.3 = 3
  144.     g_wid. = 8;                g_wid.1 = 0;            g_wid.3 = 12
  145.     g_hei. = char.h + 4;    g_hei.1 = char.h + 1;    g_hei.3 = char.h + 6
  146.     g_sx = char.w % 2;    g_sy = char.h % 4
  147.     g_onoff. = 0
  148.  
  149.     box.left = box.left + g_sx; box.top = box.top + 2 * g_sy
  150.     box.w = 30 * char.w
  151.  
  152.     n = 1; nmain = 1
  153.  
  154.     x = box.left; y = box.top
  155.     CALL IniGad(3,1,0,'NUM COLS %1' n n + 2'%2%g',num.cols,4)
  156.     CALL IniGad(1,0,1,,GetLocale(9))
  157.     y = y + g_hei.3 + g_sy
  158.     CALL IniGad(3,1,0,'INC COLS %1' n n + 2'%2%g',inc.cols,8)
  159.     CALL IniGad(1,0,1,,GetLocale(4))
  160.     y = y + g_hei.3 + 2 * g_sy
  161.     CALL IniGad(3,1,0,'NUM ROWS %1' n n + 2'%2%g',num.rows,4)
  162.     CALL IniGad(1,0,1,,GetLocale(10))
  163.     y = y + g_hei.3 + g_sy
  164.     CALL IniGad(3,1,0,'INC ROWS %1' n 1 '%2%g',inc.rows,8)
  165.     CALL IniGad(1,0,1,,GetLocale(5))
  166.     y = y + g_hei.3 + 2 * g_sy
  167.     CALL IniGad(4,1,0,'MEM %1' n,memory,GetLocale(1))
  168.  
  169.     y = y + g_hei.3 + 2 * g_sy
  170.     CALL IniGad(2,1,0,'START',GetLocale(7))
  171.     g_gads = IniGad(2,3,0,'HELP',GetLocale(8))
  172.  
  173.     box.h = y + g_hei.2 + 2 * g_sy - box.top
  174.  
  175.     WINDOW jobID modID (box.w + 2 * g_sx) (box.h + 2 * g_sy) 1 1
  176.     CALL Gadgets(4,1,g_gads)
  177.  
  178. RETURN nmain
  179.  
  180.  
  181. Gadgets:
  182.  
  183.     IF ARG(1) < 4 THEN
  184.         DO i = 2 TO ARG(); n = ARG(i)
  185.             IF ARG(1) ~= 1 THEN CALL DelGad(n,g_type.n)
  186.             IF ARG(1) ~= 3 THEN CALL NewGad(n,g_type.n)
  187.         END
  188.  
  189.     ELSE IF ARG(1) < 7 THEN
  190.         DO n = ARG(2) TO ARG(3)
  191.             IF ARG(1) ~= 4 THEN CALL DelGad(n,g_type.n)
  192.             IF ARG(1) ~= 6 THEN CALL NewGad(n,g_type.n)
  193.         END
  194.  
  195.     ELSE IF ARG(1) = 8 THEN
  196.         DO n = ARG(2) TO ARG(3)
  197.             IF g_onoff.n THEN CALL NewGad(n,g_type.n)
  198.         END
  199.  
  200.     ELSE DO
  201.         DO n = ARG(2) TO ARG(3)
  202.             g_onoff.n = 0
  203.             IF g_type.n ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  204.         END
  205.         CALL SetAPen(olewin,0)
  206.         CALL RectFill(olewin,box.left,box.top,box.left + box.w,box.top + box.h)
  207.         CALL RefreshGadgets(olewin)
  208.         END
  209. RETURN
  210.  
  211.  
  212. DelGad:
  213. PARSE ARG n,t
  214.  
  215.     g_onoff.n = 0
  216.  
  217.     IF t ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  218.  
  219.     x = g_xpos.n - g_offx.t; y = g_ypos.n - g_offy.t
  220.     CALL SetAPen(olewin,0)
  221.     CALL RectFill(olewin,x,y,x + g_len.n,y + g_hei.t)
  222.  
  223. RETURN
  224.  
  225.  
  226. NewGad:
  227. PARSE ARG n,t
  228.  
  229.     g_onoff.n = 1
  230.  
  231.     IF t = 2 THEN
  232.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n)
  233.  
  234.     ELSE IF t = 3 THEN
  235.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n,g_len.n - 4,"RIDGEBORDER")
  236.  
  237.     ELSE IF t = 4 THEN
  238.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)
  239.  
  240.     ELSE DO
  241.         CALL SetAPen(olewin,1)
  242.         CALL Move(olewin,g_xpos.n,g_ypos.n)
  243.         CALL Text(olewin,g_str.n)
  244.         END
  245. RETURN
  246.  
  247.  
  248. IniGad:
  249. PARSE ARG t,na,nx,g_msg.n,g_str.n,var
  250.  
  251.     x = x + nx * g_sx
  252.  
  253.     IF t = 3 & var > 0 THEN
  254.         g_len.n = var * char.w + g_wid.t
  255.     ELSE IF t = 3 THEN
  256.         g_len.n = box.left + box.w - x
  257.     ELSE
  258.         g_len.n = LENGTH(g_str.n) * char.w + g_wid.t
  259.  
  260.     IF na > 0 THEN x = box.left + (na - 1) * (box.w - g_len.n) % 2 + nx * g_sx
  261.  
  262.     g_xpos.n = x + g_offx.t; g_ypos.n = y + g_offy.t; g_type.n = t
  263.     x = x + g_len.n
  264.     n = n + 1
  265.  
  266.     IF t = 4 THEN CALL IniGad(1,0,1,,var)
  267.  
  268. RETURN n - 1
  269.